home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0017_DPMI Memory Swap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-08  |  6.4 KB  |  175 lines
  1.  
  2. {===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 05-30-93 (02:30)             Number: 25203
  5. From: GUY MCLOUGHLIN               Refer#: NONE
  6.   To: ALL                           Recvd: NO
  7. Subj: BP7 DPMI SWAP-FILE #1          Conf: (552) R-TP
  8. ---------------------------------------------------------------------------
  9.  
  10.   Hi to All:
  11.  
  12.   ...I saw this source-code posted by one of the support people in
  13.   the Borland Pascal conference on Compuserve. For those of you
  14.   who are writing DPMI apps, this could come in quite handy as
  15.   a means of obtaining "virtual" DPMI HEAP space.
  16.  
  17.   *** NOTE: This unit is ONLY for BORLAND PASCAL 7, and cannot be
  18.             compiled with any version of Turbo Pascal. <sorry>
  19. ------------------------------------------------------------------------}
  20.  
  21.  {.$DEFINE DebugMode}
  22.  
  23.  {$IFDEF DebugMode}
  24.    {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X+,Y+}
  25.  {$ELSE}
  26.    {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
  27.  {$ENDIF}
  28.  
  29.  {$IFNDEF DPMI}
  30.    ERROR!!! UNIT MUST BE COMPILED FOR PROTECTED MODE TARGET!!!
  31.  {$ENDIF}
  32.  
  33. unit RTMswap;
  34.  
  35. interface
  36.  
  37. const
  38.   rtmOK          = $0;
  39.   rtmNoMemory    = $1;
  40.   rtmFileIOError = $22;
  41.  
  42.   (***** Opens a swapfile of the specified size. If a swapfile        *)
  43.   (*     already exists, and the new size is larger, the swapfile     *)
  44.   (*     will grow, otherwise the previous swap file parameters       *)
  45.   (*     are used.                                                    *)
  46.   (*                                                                  *)
  47.   (*    Returns:   rtmOK           - Successful                       *)
  48.   (*               rtmNoMemory     - Not enough disk space            *)
  49.   (*               rtmFileIOError  - Could not open/grow file         *)
  50.   (*                                                                  *)
  51.   function MemInitSwapFile({input } FileName : pchar;
  52.                                     FileSize : longint) :
  53.                            {output} integer;
  54.  
  55.   (***** Closes the swapfile if it was created by the current task.   *)
  56.   (*     If the value returned in "Delete" is non-zero, the swapfile  *)
  57.   (*     was deleted.                                                 *)
  58.   (*                                                                  *)
  59.   (*    Returns:   rtmOK           - Successful                       *)
  60.   (*               rtmNoMemory     - Not enough physical memory to    *)
  61.   (*                                 run without the swap file.       *)
  62.   (*               rtmFileIOError  - Could not close/delete the file. *)
  63.   (*                                                                  *)
  64.   function MemCloseSwapFile({update} var Delete : integer) :
  65.                             {output} integer;
  66.  
  67.  implementation
  68.  
  69.    function MemInitSwapFile; external 'RTM' index 35;
  70.  
  71.    function MemCloseSwapFile; external 'RTM' index 36;
  72.  
  73.  END.
  74.  
  75.  
  76. {------------------------------------------------------------------------
  77.  
  78.   ...I still can't figure out what to do with the value returned in
  79.   the "Delete" parameter passed to "MemCloseSwapFile", as it doesn't
  80.   seem to return any specific value for me??? (Maybe it has to fail
  81.   to return a value???)
  82.  
  83.   ...The next message is a demo program using this "RTMswap" unit.
  84.  
  85.  
  86.                                - Guy                                }
  87.  
  88.  {.$DEFINE DebugMode}
  89.  
  90.  {$IFDEF DebugMode}
  91.    {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X+,Y+}
  92.  {$ELSE}
  93.    {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
  94.  {$ENDIF}
  95.  
  96.  {$IFNDEF DPMI}
  97.    ERROR!!! PROGRAM MUST BE COMPILED FOR PROTECTED MODE TARGET!!!
  98.  {$ENDIF}
  99.  
  100.               (* Program to demonstrate how to create/delete DPMI     *)
  101.               (* HEAP swap-file.                                      *)
  102. program RTMswap_Demo;
  103. uses
  104.   RTMswap;
  105.  
  106. const         (* Maximum size for DPMI HEAP in bytes.                 *)
  107.    DPMI_HeapMax = 16000 * 1024;
  108.  
  109. var
  110.   SwapError,
  111.   DeleteStatus : integer;
  112.   SwapSize     : longint;
  113.   SwapFilename : pchar;
  114.  
  115. BEGIN
  116.               (* Calculate required DPMI HEAP swap-file size.         *)
  117.   SwapSize := (DPMI_HeapMax - memavail);
  118.  
  119.               (* Display current DPMI HEAP size.                      *)
  120.   writeln;
  121.   writeln('Current DPMI HEAP size = ', (memavail div 1024), ' K');
  122.   writeln;
  123.   writeln('Increasing DPMI HEAP to 16,000 K via swap-file');
  124.   writeln;
  125.  
  126.               (* Assign DPMI HEAP swap-file name.                     *)
  127.   SwapFilename := 'SWAPDEMO.$$$';
  128.  
  129.               (* Attempt to create DPMI HEAP swap-file.               *)
  130.   SwapError := MemInitSwapFile(SwapFilename, SwapSize);
  131.  
  132.               (* Check for errors in creating DPMI HEAP swap-file.    *)
  133.   case SwapError of
  134.     rtmOK          : begin
  135.                        writeln((SwapSize div 1024), ' K DPMI HEAP ' +
  136.                                'swap file created');
  137.                        writeln;
  138.                        writeln('Total DPMI HEAP size now = ',
  139.                                (memavail div 1024), ' K');
  140.                        writeln
  141.                      end;
  142.     rtmNoMemory    : writeln('ERROR!!! Not enough disk space to ' +
  143.                              'create DPMI HEAP swap-file');
  144.     rtmFileIOerror : writeln('ERROR!!! Could not open/grow DPMI ' +
  145.                              'HEAP swapfile')
  146.   else
  147.     writeln('UNKNOWN RTM ERROR!!!')
  148.   end;
  149.  
  150.               (* If DPMI HEAP swap-file was created, then close it.   *)
  151.   if (SwapError = rtmOK) then
  152.     begin
  153.       writeln('Closing DPMI HEAP swap-file'); writeln;
  154.  
  155.               (* Attempt to close DPMI HEAP swap-file.                *)
  156.       SwapError := MemCloseSwapFile(DeleteStatus);
  157.  
  158.               (* Check for errors in closing DPMI HEAP swap-file.     *)
  159.       case SwapError of
  160.         rtmOK          : begin
  161.                            writeln('DPMI HEAP swap-file is closed');
  162.                            writeln;
  163.                            writeln('Current DPMI HEAP size now = ',
  164.                                    (memavail div 1024), ' K')
  165.                          end;
  166.         rtmNoMemory    : writeln('ERROR!!! Not enough RAM to run ' +
  167.                                  'without swap-file');
  168.         rtmFileIOerror : writeln('ERROR!!! Could not close/delete ' +
  169.                                  'swapfile')
  170.       else
  171.         writeln('UNKNOWN RTM ERROR!!!')
  172.       end
  173.     end
  174. END.
  175.